As an extra incentive for completing one of our studies, we planning to provide people with personalized feedback on their personality based on their responses to the HEXACO-60 questionnaire. In particular, we’ll tell people how their scores on the six traits compare to some norming data provided by the authors of the HEXACO at hexaco.org. For this portfolio, I’d like to try making some visualizations to be used in this feedback.
Using the means and standard deviations from Ashton et al.’s norming data, I wanted to generate some normally distruted data that should roughly approximate the distribution of their study.
hexaco_norm <- data.frame(matrix(ncol = 0, nrow = 1126))
set.seed(1998)
hexaco_norm$hh <- rtruncnorm(1126, 1, 5, 3.23, .66)
hexaco_norm$em <- rtruncnorm(1126, 1, 5, 3.36, .7)
hexaco_norm$ex <- rtruncnorm(1126, 1, 5, 3.51, .62)
hexaco_norm$ag <- rtruncnorm(1126, 1, 5, 3.10, .63)
hexaco_norm$cn <- rtruncnorm(1126, 1, 5, 3.47, .61)
hexaco_norm$op <- rtruncnorm(1126, 1, 5, 3.49, .67)
Then, I want to plot these as density distributions. Because I make a lot of density distributions, and making them the way I like requires quite a bit of code, I decided I’d go ahead and write a function that does a lot of the ggplotting for me to make this process somewhat more efficient.
Below are the 6 distributions of scores we generated for each of the 6 traits based on Ashton et al.’s norming data.
library(rlang)
##
## Attaching package: 'rlang'
## The following objects are masked from 'package:purrr':
##
## %@%, as_function, flatten, flatten_chr, flatten_dbl, flatten_int,
## flatten_lgl, flatten_raw, invoke, splice
density_plot <- function(data, x, color, ymax, xmin, xmax, alpha) {
ggplot2::ggplot(data = data, aes({{x}}))+
geom_density(color = "black", fill = color, linewidth = 0.9, bw = 0.3, alpha = alpha)+
theme_classic()+
scale_y_continuous(
limits = c(0, ymax),
expand = c(0, 0))+
scale_x_continuous(
limits = c(xmin, xmax),
expand = c(0, 0.01))
}
density_plot(hexaco_norm, hh, "gold1", 0.6, 1, 5, 0.5)
density_plot(hexaco_norm, em, "firebrick1", 0.6, 1, 5, 0.5)
density_plot(hexaco_norm, ex, "palegreen2", 0.6, 1, 5, 0.5)
density_plot(hexaco_norm, ag, "steelblue1", 0.6, 1, 5, 0.5)
density_plot(hexaco_norm, cn, "orange1", 0.7, 1, 5, 0.5)
density_plot(hexaco_norm, op, "purple1", 0.6, 1, 5, 0.5)
Now I want to try making an interactive plot that would show the
percentile score (based on the norming data) for a given score on one of
the HEXACO traits and graphically display how it compares to various
percentiles. For this example, I used a hypothetical person who scores
3.4 out of a possible 5 mean score for Honesty-Humility (HH). This score
is then converted to a percentile score and plotted against the
distribution we generated for HH.
hexaco_norm$score <- rep(3.4, times = 1126)
hexaco_norm$Your_Score <- ecdf(hexaco_norm$hh)(hexaco_norm$score)
hexaco_norm <- hexaco_norm %>%
mutate(Your_Score = round(Your_Score*100))
hhplot <- ggplot(hexaco_norm, aes(x = hh))+
geom_density(color = "goldenrod4", fill = "gold1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend = quantile(hh, probs = 0.5), yend = 0.56, text = "Average"), color = "goldenrod4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
geom_segment(aes(x = quantile(hh, probs = 0.01), y = 0.6, xend = quantile(hh, probs = 0.99), yend = 0.6), linewidth = 1, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "goldenrod3")+
geom_segment(aes(x = score, y = 0, xend = score, yend = 0.6), color = "black", linewidth = 1)+
geom_point(aes(x = score, y = 0.6, text = Your_Score), color = "black", size = 4.5)+
geom_text(aes(x = score, y = 0.63, label = "Your Score"))+
theme_void()+
scale_y_continuous(
limits = c(0, 0.7),
expand = c(0, 0))
## Warning in geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend =
## quantile(hh, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = score, y = 0.6, text = Your_Score), color =
## "black", : Ignoring unknown aesthetics: text
library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
ggplotly(hhplot, tooltip = "text")
Alright! Now that we got that to work, let’s try making a full personality profile for all 6 traits using existing data from a real participant in a past study.
real_data <- read.csv("data/hexaco scores.csv")
one_data <- real_data %>%
filter(ID == 10)
#Getting HEXACO scores
hexaco_norm$op_score <- rep(one_data$openness, times = 1126)
hexaco_norm$ag_score <- rep(one_data$agreeableness, times = 1126)
hexaco_norm$ex_score <- rep(one_data$extraversion, times = 1126)
hexaco_norm$cn_score <- rep(one_data$conscientiousness, times = 1126)
hexaco_norm$hh_score <- rep(one_data$honestyhumility, times = 1126)
hexaco_norm$em_score <- rep(one_data$emotionality, times = 1126)
#Getting scores as percentiles
hexaco_norm$op_qscore <- ecdf(hexaco_norm$op)(hexaco_norm$op_score)
hexaco_norm$ag_qscore <- ecdf(hexaco_norm$ag)(hexaco_norm$ag_score)
hexaco_norm$ex_qscore <- ecdf(hexaco_norm$ex)(hexaco_norm$ex_score)
hexaco_norm$cn_qscore <- ecdf(hexaco_norm$cn)(hexaco_norm$cn_score)
hexaco_norm$hh_qscore <- ecdf(hexaco_norm$hh)(hexaco_norm$hh_score)
hexaco_norm$em_qscore <- ecdf(hexaco_norm$em)(hexaco_norm$em_score)
hexaco_norm <- hexaco_norm %>%
mutate(op_qscore = round(op_qscore*100),
ag_qscore = round(ag_qscore*100),
ex_qscore = round(ex_qscore*100),
cn_qscore = round(cn_qscore*100),
hh_qscore = round(hh_qscore*100),
em_qscore = round(em_qscore*100))
opplot <- ggplot(hexaco_norm, aes(x = op))+
geom_density(color = "purple4", fill = "purple1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
geom_segment(aes(x = quantile(op, probs = 0.5), y = 0, xend = quantile(op, probs = 0.5), yend = 0.55, text = "Average"), color = "purple4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
geom_segment(aes(x = quantile(op, probs = 0.01), y = 0.6, xend = quantile(op, probs = 0.99), yend = 0.6), linewidth = 1, color = "purple3")+
geom_point(aes(x = quantile(op, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "purple3")+
geom_point(aes(x = quantile(op, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "purple3")+
geom_point(aes(x = quantile(op, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "purple3")+
geom_point(aes(x = quantile(op, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "purple3")+
geom_point(aes(x = quantile(op, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "purple3")+
geom_point(aes(x = quantile(op, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "purple3")+
geom_point(aes(x = quantile(op, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "purple3")+
geom_segment(aes(x = op_score, y = 0, xend = op_score, yend = 0.6), color = "black", linewidth = 1)+
geom_point(aes(x = op_score, y = 0.6, text = op_qscore), color = "black", size = 4.5)+
geom_text(aes(x = op_score, y = 0.63, label = "Your Score"))+
theme_void()+
scale_y_continuous(
limits = c(0, 0.7),
expand = c(0, 0))+
labs(title = "Openness to Experience")
## Warning in geom_segment(aes(x = quantile(op, probs = 0.5), y = 0, xend =
## quantile(op, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(op, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = op_score, y = 0.6, text = op_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(opplot, tooltip = "text")
agplot <- ggplot(hexaco_norm, aes(x = ag))+
geom_density(color = "steelblue4", fill = "steelblue1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
geom_segment(aes(x = quantile(ag, probs = 0.5), y = 0, xend = quantile(ag, probs = 0.5), yend = 0.55, text = "Average"), color = "steelblue4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
geom_segment(aes(x = quantile(ag, probs = 0.01), y = 0.65, xend = quantile(ag, probs = 0.99), yend = 0.65), linewidth = 1, color = "steelblue3")+
geom_point(aes(x = quantile(ag, probs = 0.99), y = 0.65, text = "99th percentile"), size = 1.5, color = "steelblue3")+
geom_point(aes(x = quantile(ag, probs = 0.01), y = 0.65, text = "1st percentile"), size = 1.5, color = "steelblue3")+
geom_point(aes(x = quantile(ag, probs = 0.95), y = 0.65, text = "95th percentile"), size = 2, color = "steelblue3")+
geom_point(aes(x = quantile(ag, probs = 0.05), y = 0.65, text = "5th percentile"), size = 2, color = "steelblue3")+
geom_point(aes(x = quantile(ag, probs = 0.80), y = 0.65, text = "80th percentile"), size = 2.5, color = "steelblue3")+
geom_point(aes(x = quantile(ag, probs = 0.20), y = 0.65, text = "20th percentile"), size = 2.5, color = "steelblue3")+
geom_point(aes(x = quantile(ag, probs = 0.5), y = 0.65, text = "Average"), size = 4, color = "steelblue3")+
geom_segment(aes(x = ag_score, y = 0, xend = ag_score, yend = 0.65), color = "black", linewidth = 1)+
geom_point(aes(x = ag_score, y = 0.65, text = ag_qscore), color = "black", size = 4.5)+
geom_text(aes(x = ag_score, y = 0.68, label = "Your Score"))+
theme_void()+
scale_y_continuous(
limits = c(0, 0.75),
expand = c(0, 0))+
labs(title = "Agreeableness")
## Warning in geom_segment(aes(x = quantile(ag, probs = 0.5), y = 0, xend =
## quantile(ag, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.99), y = 0.65, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.01), y = 0.65, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.95), y = 0.65, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.05), y = 0.65, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.8), y = 0.65, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.2), y = 0.65, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ag, probs = 0.5), y = 0.65, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = ag_score, y = 0.65, text = ag_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(agplot, tooltip = "text")
explot <- ggplot(hexaco_norm, aes(x = ex))+
geom_density(color = "forestgreen", fill = "palegreen1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
geom_segment(aes(x = quantile(ex, probs = 0.5), y = 0, xend = quantile(ex, probs = 0.5), yend = 0.58, text = "Average"), color = "forestgreen", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
geom_segment(aes(x = quantile(ex, probs = 0.01), y = 0.65, xend = quantile(ex, probs = 0.99), yend = 0.65), linewidth = 1, color = "palegreen3")+
geom_point(aes(x = quantile(ex, probs = 0.99), y = 0.65, text = "99th percentile"), size = 1.5, color = "palegreen3")+
geom_point(aes(x = quantile(ex, probs = 0.01), y = 0.65, text = "1st percentile"), size = 1.5, color = "palegreen3")+
geom_point(aes(x = quantile(ex, probs = 0.95), y = 0.65, text = "95th percentile"), size = 2, color = "palegreen3")+
geom_point(aes(x = quantile(ex, probs = 0.05), y = 0.65, text = "5th percentile"), size = 2, color = "palegreen3")+
geom_point(aes(x = quantile(ex, probs = 0.80), y = 0.65, text = "80th percentile"), size = 2.5, color = "palegreen3")+
geom_point(aes(x = quantile(ex, probs = 0.20), y = 0.65, text = "20th percentile"), size = 2.5, color = "palegreen3")+
geom_point(aes(x = quantile(ex, probs = 0.5), y = 0.65, text = "Average"), size = 4, color = "palegreen3")+
geom_segment(aes(x = ex_score, y = 0, xend = ex_score, yend = 0.65), color = "black", linewidth = 1)+
geom_point(aes(x = ex_score, y = 0.65, text = ex_qscore), color = "black", size = 4.5)+
geom_text(aes(x = ex_score, y = 0.68, label = "Your Score"))+
theme_void()+
scale_y_continuous(
limits = c(0, 0.75),
expand = c(0, 0))+
labs(title = "Extraversion")
## Warning in geom_segment(aes(x = quantile(ex, probs = 0.5), y = 0, xend =
## quantile(ex, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.99), y = 0.65, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.01), y = 0.65, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.95), y = 0.65, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.05), y = 0.65, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.8), y = 0.65, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.2), y = 0.65, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(ex, probs = 0.5), y = 0.65, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = ex_score, y = 0.65, text = ex_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(explot, tooltip = "text")
hhplot <- ggplot(hexaco_norm, aes(x = hh))+
geom_density(color = "goldenrod4", fill = "gold1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend = quantile(hh, probs = 0.5), yend = 0.54, text = "Average"), color = "goldenrod4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
geom_segment(aes(x = quantile(hh, probs = 0.01), y = 0.6, xend = quantile(hh, probs = 0.99), yend = 0.6), linewidth = 1, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "goldenrod3")+
geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "goldenrod3")+
geom_segment(aes(x = hh_score, y = 0, xend = hh_score, yend = 0.6), color = "black", linewidth = 1)+
geom_point(aes(x = hh_score, y = 0.6, text = hh_qscore), color = "black", size = 4.5)+
geom_text(aes(x = hh_score, y = 0.63, label = "Your Score"))+
theme_void()+
scale_y_continuous(
limits = c(0, 0.7),
expand = c(0, 0))+
labs(title = "Honesty-Humility")
## Warning in geom_segment(aes(x = quantile(hh, probs = 0.5), y = 0, xend =
## quantile(hh, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(hh, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = hh_score, y = 0.6, text = hh_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(hhplot, tooltip = "text")
cnplot <- ggplot(hexaco_norm, aes(x = cn))+
geom_density(color = "orange4", fill = "orange1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
geom_segment(aes(x = quantile(cn, probs = 0.5), y = 0, xend = quantile(cn, probs = 0.5), yend = 0.58, text = "Average"), color = "orange4", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
geom_segment(aes(x = quantile(cn, probs = 0.01), y = 0.65, xend = quantile(cn, probs = 0.99), yend = 0.65), linewidth = 1, color = "orange3")+
geom_point(aes(x = quantile(cn, probs = 0.99), y = 0.65, text = "99th percentile"), size = 1.5, color = "orange3")+
geom_point(aes(x = quantile(cn, probs = 0.01), y = 0.65, text = "1st percentile"), size = 1.5, color = "orange3")+
geom_point(aes(x = quantile(cn, probs = 0.95), y = 0.65, text = "95th percentile"), size = 2, color = "orange3")+
geom_point(aes(x = quantile(cn, probs = 0.05), y = 0.65, text = "5th percentile"), size = 2, color = "orange3")+
geom_point(aes(x = quantile(cn, probs = 0.80), y = 0.65, text = "80th percentile"), size = 2.5, color = "orange3")+
geom_point(aes(x = quantile(cn, probs = 0.20), y = 0.65, text = "20th percentile"), size = 2.5, color = "orange3")+
geom_point(aes(x = quantile(cn, probs = 0.5), y = 0.65, text = "Average"), size = 4, color = "orange3")+
geom_segment(aes(x = cn_score, y = 0, xend = cn_score, yend = 0.65), color = "black", linewidth = 1)+
geom_point(aes(x = cn_score, y = 0.65, text = cn_qscore), color = "black", size = 4.5)+
geom_text(aes(x = cn_score, y = 0.68, label = "Your Score"))+
theme_void()+
scale_y_continuous(
limits = c(0, 0.75),
expand = c(0, 0))+
labs(title = "Conscientiousness")
## Warning in geom_segment(aes(x = quantile(cn, probs = 0.5), y = 0, xend =
## quantile(cn, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.99), y = 0.65, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.01), y = 0.65, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.95), y = 0.65, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.05), y = 0.65, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.8), y = 0.65, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.2), y = 0.65, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(cn, probs = 0.5), y = 0.65, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = cn_score, y = 0.65, text = cn_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(cnplot, tooltip = "text")
emplot <- ggplot(hexaco_norm, aes(x = em))+
geom_density(color = "firebrick4", fill = "firebrick1", linewidth = 0.9, bw = 0.3, alpha = 0.7)+
geom_segment(aes(x = quantile(em, probs = 0.5), y = 0, xend = quantile(em, probs = 0.5), yend = 0.53, text = "Average"), color = "firebrick", linetype = "dashed", linewidth = 0.4, alpha = 0.5)+
geom_segment(aes(x = quantile(em, probs = 0.01), y = 0.6, xend = quantile(em, probs = 0.99), yend = 0.6), linewidth = 1, color = "firebrick")+
geom_point(aes(x = quantile(em, probs = 0.99), y = 0.6, text = "99th percentile"), size = 1.5, color = "firebrick")+
geom_point(aes(x = quantile(em, probs = 0.01), y = 0.6, text = "1st percentile"), size = 1.5, color = "firebrick")+
geom_point(aes(x = quantile(em, probs = 0.95), y = 0.6, text = "95th percentile"), size = 2, color = "firebrick")+
geom_point(aes(x = quantile(em, probs = 0.05), y = 0.6, text = "5th percentile"), size = 2, color = "firebrick")+
geom_point(aes(x = quantile(em, probs = 0.80), y = 0.6, text = "80th percentile"), size = 2.5, color = "firebrick")+
geom_point(aes(x = quantile(em, probs = 0.20), y = 0.6, text = "20th percentile"), size = 2.5, color = "firebrick")+
geom_point(aes(x = quantile(em, probs = 0.5), y = 0.6, text = "Average"), size = 4, color = "firebrick")+
geom_segment(aes(x = em_score, y = 0, xend = em_score, yend = 0.6), color = "black", linewidth = 1)+
geom_point(aes(x = em_score, y = 0.6, text = em_qscore), color = "black", size = 4.5)+
geom_text(aes(x = em_score, y = 0.63, label = "Your Score"))+
theme_void()+
scale_y_continuous(
limits = c(0, 0.7),
expand = c(0, 0))+
labs(title = "Emotionality")
## Warning in geom_segment(aes(x = quantile(em, probs = 0.5), y = 0, xend =
## quantile(em, : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.99), y = 0.6, text = "99th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.01), y = 0.6, text = "1st
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.95), y = 0.6, text = "95th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.05), y = 0.6, text = "5th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.8), y = 0.6, text = "80th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.2), y = 0.6, text = "20th
## percentile"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = quantile(em, probs = 0.5), y = 0.6, text =
## "Average"), : Ignoring unknown aesthetics: text
## Warning in geom_point(aes(x = em_score, y = 0.6, text = em_qscore), color =
## "black", : Ignoring unknown aesthetics: text
ggplotly(emplot, tooltip = "text")
It worked!
I’m interested in trying to make this process more or less automatic so that it can be performed easily in a short amount of time for lots of participants. My first approach was to just stick everything I had just done into a function. This almost works, except the function will ultimately only spit out one of the 6 plots we want.
After this, I decided to implement things a slightly different way by writing a slightly different function and implementing it into an R Markdown document that, when knit, will automatically generate an html file with a HEXACO report for the person specified. I can add some more explanatory text to this file, and then it will be about ready to go for our purposes!
trait_output(real_data, 11)